OPTIONAL FIXEDPOINT

Only Forth Definitions

Requires Float-tools
Requires Tools

{ ====================================================================================
   Bit Format: 16.16

   If * or / are used, the parameters can be as follows: ( fixed int -- fixed )
====================================================================================== }

\ Conversion
\ =====================================================================================


65536e fvalue 65536e  \ makes fixed point conversion 1.33x faster
1e 65536e f/ fvalue 1/65536e
icode s>.
   EBX 16 # SHL
   ret end-code

icode .>s
   EBX 16 # SAR
   ret end-code

: .>f   s>f 1/65536e f* ;
: f>.   65536e f* f>s ;

\ Math
\ =====================================================================================

pi f>. constant pi.
pi/2 f>. constant pi/2.
pi/180 f>. constant pi/180.
180e pi f/ f>. constant 180/pi.

\ : .*   65536 */ ;
\ 4x faster
icode .*
  ebx eax mov
  0 [ebp] imul
  4 # ebp add
  dx ax mov
  eax 16 # ror
  eax ebx mov
  ret end-code

: ./   65536 swap */ ;
{  \ this was not any faster.
icode ./
  0 [ebp] eax mov
  eax 16 # ror
  ax dx movsx
  $ffff0000 # eax and
  ebx idiv
  4 # ebp add
  eax ebx mov
  ret end-code
}

: .COS   .>F fCOS F>. ;
: .SIN   .>F fSIN F>. ;
: .d>r   pi/180. .* ;
: .r>d   180/pi. .* ;

: sins,   65536 0 do i 411480 65536 */ .sin 65537 .* dup 0> if 1 + then , loop ;
create sintbl sins,
:macro .sin   360.0 ./ 65535 and cells sintbl + @ ;
:macro .cos   360.0 ./ 16384 + 65535 and cells sintbl + @ ;

: lerp   ( src dest n. -- )
   >r over - r> .* + ;

:macro .+    + ;
:macro .-    - ;
:macro .SQRT   .>f fsqrt f>. ;


\ Printing
\ =====================================================================================

: .int  $ffff0000 and ;
: int.    .>s . ;
: ..    .>f f. ;
: .?    @ .. ;
: 2..    swap .. .. ;
: 3..    rot .. swap .. .. ;

\ Extend literal interpreter/compiler
\ =====================================================================================

VARIABLE .sign
: .FCONVERT ( a -- 0 | a -1 ) ( -- | r )
   <SIGN>    ( a c f)  DROP [CHAR] - = .sign !
   <DIGITS>  ( a d n)  0= IF 2DROP DROP 0 EXIT THEN D>F
   <DOT>     ( a c f)  0= IF FDROP 2DROP 0 EXIT THEN DROP
   <DIGITS>  ( a d n)  -ROT D>F T10** F/ F+
                       .sign @ IF FNEGATE THEN
   <E>       ( a c f)  IF FDROP 2DROP 0 EXIT THEN DROP
   -1 ;

: >.FLOAT ( caddr n -- true | false ) ( -- r )
   R-BUF  R@ ZPLACE  R@ .FCONVERT ( 0 | a\f ) IF
      R> ZCOUNT + = DUP ?EXIT FDROP EXIT
   THEN R> DROP 0 ;

: .NUMBER? ( addr len 0 | ... xt -- addr len 0 | ... xt )
     DUP IF EXIT THEN
     DROP
     BASE @ 10 = IF
          2DUP >.FLOAT IF 2DROP
               65536e ( 4096e ) f* f>s ['] LITERAL  EXIT THEN
     THEN   0 ;

' .NUMBER? NUMBER-CONVERSION >CHAIN

\ Multiple stack item conversions
\ =====================================================================================

{
: 2s>.   s>. swap s>. swap ;
: 2.>s   .>s swap .>s swap ;
}

icode 2s>.
   ebx 16 # shl
   0 [ebp] 16 # shl
   ret end-code

icode 2.>s
   ebx 16 # sar
   0 [ebp] 16 # sar
   ret end-code

{
: 3s>.   >r 2s>. r> s>. ;
: 3.>s   >r 2.>s r> .>s ;
}

icode 3s>.
   ebx 16 # shl
   0 [ebp] 16 # shl
   4 [ebp] 16 # shl
   ret end-code

icode 3.>s
   ebx 16 # sar
   0 [ebp] 16 # sar
   4 [ebp] 16 # sar
   ret end-code


: 2.>f   swap .>f .>f ;
: 3.>f   >r >r .>f r> .>f r> .>f ;
: 4.>f   >r >r swap .>f .>f r> .>f r> .>f  ;




\ Ellipse math

: ellipse-perimeter  ( radiusx. radiusy. -- n. )
  2dup + 3.0 .*
  -rot
  2dup 3.0 .* +
  -rot
  swap 3.0 .* + .*
  .sqrt - pi. .* ;

: ellipse-area  ( radiusx. radiusy. -- n. )
  pi. .* .* ;

: ellipse-point  ( radiusx. radiusy. degree. -- x. y. )
  locals| degrees radiusy radiusx |
    degrees .cos radiusx .*
    degrees .sin radiusy .* ;

: within-ellipse?  ( x. y. radiusx. radiusy. -- flag )
  rot swap ./ dup .*
  -rot ./ dup .* + 1.0 < ;

\ Circle math

: circle-area   ( radius. -- n. )
  dup ellipse-area ;

: circle-perimeter  ( radius. -- n. )
  pi. .* dup .+ ;

: circle-point  ( radiusx. degree. -- x. y. )
  >r dup r> ellipse-point ;

: within-circle?  ( x. y. radius. -- flag )
    dup within-ellipse? ;
